home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Deutsche Edition 1
/
Deutsche Edition 1.iso
/
amok
/
011-020
/
amok16
/
rotateiff
/
rotate.mod
< prev
next >
Wrap
Text File
|
1993-11-04
|
8KB
|
262 lines
(*---------------------------------------------------------------------------
:Program. Rotate.mod
:Author. Fridtjof Siebert
:Address. Nobileweg 67, D-7-Stgt-40
:Phone. 0711/822509
:Shortcut. [fbs]
:Version. 0.1
:Date. 19-Feb-88
:Copyright. PD
:Language. Modula-II
:Translator. M2Amiga v3.1d
:Imports. IFFSupport.mod [fbs], AMOK #6
:Imports. ControlIntuition [fbs], AMOK #1
:Contents. Small Graphics Demonstration
:Usage. Rotate <IFF-Pic>
:Bugs. Eats about 3K of memory. Sorry!
---------------------------------------------------------------------------*)
(* $S- $F- $N- $R- $V- *)
MODULE Rotate;
FROM SYSTEM IMPORT INLINE, ADDRESS, ADR, CAST;
FROM Arts IMPORT TermProcedure, Terminate;
FROM Arguments IMPORT NumArgs, GetArg;
FROM Exec IMPORT FreeMem, AllocMem, MemReqs, MemReqSet;
FROM Graphics IMPORT BitMapPtr, BitMap, WaitBOVP, ViewPort, RasInfo,
InitVPort, GetColorMap, FreeColorMap, View,
InitView, MakeVPort, MrgCop, LoadView, ViewPtr,
SetRGB4CM, FreeSprite, ViewModes, ViewModeSet,
UCopList, FreeCopList;
FROM GfxMacros IMPORT CINIT, CMOVE, CWAIT, CEND;
FROM Hardware IMPORT custom;
FROM Intuition IMPORT ViewAddress, ScreenPtr, WindowPtr;
FROM IFFSupport IMPORT ReadILBM, ReadILBMFlags, ReadILBMFlagSet, NuScreen,
IFFInfo;
FROM ControlIntuition IMPORT DisableIntuition, EnableIntuition;
(* I'm sorry for my choatic programming style. So don't look at this source
if you want to keep your good style! *)
TYPE LI = LONGINT;
CONST
D0 = 0;
A0 = 8;
A1 = 9;
VAR
scr: ScreenPtr;
win: WindowPtr;
Name: ARRAY[0..79] OF CHAR;
length: INTEGER;
bitMap: BitMapPtr;
vBitMap: BitMap;
y,i,j,dx,p: LI;
a,b: ADDRESS;
Sinus: POINTER TO ARRAY[0..64] OF INTEGER;
SmallSine: POINTER TO ARRAY[0..31] OF CARDINAL;
MaxAdr: LI;
Ciapra [0BFE001H]: SET OF (s0,s1,s2,s3,s4,s5,lmb);
vPort: ViewPort;
rInfo: RasInfo;
view: View;
iview: ViewPtr;
cList: UCopList;
PROCEDURE CopyBytes(num{D0}: INTEGER; from{A0},to{A1}: ADDRESS);
BEGIN INLINE(
022D8H,051C8H, (* loop: move.l (A0)+,(A1)+ *)
0FFFCH ); (* dbra D0,loop *)
END CopyBytes;
(*------ Data: ------*)
PROCEDURE Dat(); (* $E- Contains Data *)
BEGIN INLINE(
0, 402, 804, 1205, 1606, 2006, 2404, 2801, (* 0.. 7 *)
3196, 3590, 3981, 4370, 4756, 5139, 5520, 5897, (* 8..15 *)
6270, 6640, 7005, 7366, 7723, 8076, 8423, 8765, (* 16..23 *)
9102, 9434, 9760,10080,10394,10702,11003,11297, (* 24..31 *)
11585,11866,12140,12406,12665,12916,13160,13395, (* 32..39 *)
13623,13842,14053,14255,14449,14635,14811,14978, (* 40..47 *)
15137,15286,15426,15557,15678,15790,15893,15986, (* 48..55 *)
16069,16143,16207,16261,16305,16340,16364,16379, (* 56..63 *)
16384); (* 64 *)
END Dat;
PROCEDURE Dat2(); (* $E- *)
BEGIN
INLINE(8,9,11,12,13,14,15,15,15,15,14,13,12,11,9,8);
INLINE(7,6, 4, 3, 2, 1, 0, 0, 0, 0, 1, 2, 3, 4,6,7);
END Dat2;
(*------ CleanUp: ------*)
PROCEDURE CleanUp();
VAR psize: LONGINT;
BEGIN
IF bitMap#NIL THEN
WITH bitMap^ DO
psize := LI(bytesPerRow) * LI(rows);
WHILE depth#0 DO DEC(depth); FreeMem(planes[depth],psize) END;
IF vBitMap.planes[0]#NIL THEN FreeMem(vBitMap.planes[0],psize) END;
END;
FreeMem(bitMap,SIZE(BitMap));
END;
IF vPort.uCopIns#NIL THEN FreeCopList(vPort.uCopIns^.firstCopList) END;
IF vPort.colorMap#NIL THEN FreeColorMap(vPort.colorMap) END;
IF iview#NIL THEN LoadView(iview) END;
END CleanUp;
(*------ MAIN: ------*)
BEGIN
Sinus := ADR(Dat);
SmallSine := ADR(Dat2);
bitMap := NIL; vBitMap.planes[0] := NIL; vPort.colorMap := NIL;
iview := NIL; vPort.uCopIns := NIL;
TermProcedure(CleanUp);
IF NumArgs()#0 THEN GetArg(1,Name,length) ELSE Terminate(0) END;
IF NOT ReadILBM(Name,ReadILBMFlagSet{front,dontopen,visible},scr,win) THEN
Terminate(0) END;
bitMap := NuScreen.customBitMap;
WITH bitMap^ DO
vBitMap := bitMap^;
vBitMap.depth := 1;
vBitMap.planes[0] := AllocMem(LI(bytesPerRow)*LI(rows),MemReqSet{chip,memClear});
IF vBitMap.planes[0]=NIL THEN Terminate(0) END;
InitVPort(vPort);
WITH vPort DO
next := NIL;
colorMap := GetColorMap(2);
IF colorMap=NIL THEN Terminate(0) END;
WITH IFFInfo.CMAP DO
SetRGB4CM(colorMap,0,red[0],green[0],blue[0]);
SetRGB4CM(colorMap,1,red[1],green[1],blue[1]);
END;
dWidth := NuScreen.width;
dHeight := NuScreen.height;
modes := NuScreen.viewModes;
dxOffset := 0;
dyOffset := 0;
rasInfo := ADR(rInfo);
WITH rInfo DO
next := NIL;
bitMap := ADR(vBitMap);
rxOffset := 0;
ryOffset := 0;
END;
uCopIns := ADR(cList);
WITH IFFInfo.CMAP DO
CINIT(uCopIns,800);
FOR i:=0 TO 7 DO
FOR j:=0 TO 15 DO
CWAIT(uCopIns,i*32+j,0);
CMOVE(uCopIns,ADR(custom.color[0]),
(15-j)*LI(red[0])/15*256+(15-j)*LI(green[0])/15*16+(15-j)*LI(blue[0])/15);
CMOVE(uCopIns,ADR(custom.color[1]),
j*LI(red[1])/15*256+j*LI(green[1])/15*16+j*LI(blue[1])/15);
END;
FOR j:=0 TO 15 DO
CWAIT(uCopIns,i*32+j+16,0);
CMOVE(uCopIns,ADR(custom.color[0]),
j*LI(red[0])/15*256+j*LI(green[0])/15*16+j*LI(blue[0])/15);
CMOVE(uCopIns,ADR(custom.color[1]),
(15-j)*LI(red[1])/15*256+(15-j)*LI(green[1])/15*16+(15-j)*LI(blue[1])/15);
END;
END;
CEND(uCopIns,1000,255);
END;
END;
InitView(view);
view.modes := view.modes-ViewModeSet{sprites};
view.viewPort := ADR(vPort);
iview := ViewAddress();
MakeVPort(ADR(view),ADR(vPort));
MrgCop(ADR(view));
LoadView(ADR(view));
DisableIntuition; FreeSprite(0);
MaxAdr := LI(vBitMap.planes[0]) + LI(bytesPerRow) * LI(rows);
LOOP
FOR i:=0 TO 63 BY 2 DO
a := planes[0]; b := vBitMap.planes[0];
dx:= Sinus^[64-i]; p := 0; y := rows;
INC(b,LI(bytesPerRow)*((LI(rows) - LI(rows) * LI(dx) / 16384)/2));
WHILE (y>0) AND (LI(b)<MaxAdr) DO
CopyBytes((bytesPerRow-4)/4,a,b);
INC(b,bytesPerRow);
INC(p,16384);
WHILE (p>dx) AND (y>0) DO
DEC(p,dx); DEC(y,1); INC(a,bytesPerRow);
END;
END;
IF NOT(lmb IN Ciapra) THEN EXIT END;
LoadView(ADR(view));
END;
FOR i:=0 TO 63 BY 2 DO
a := planes[0]; b := vBitMap.planes[0];
dx:= Sinus^[i]; p := 0; y := rows;
INC(b,LI(bytesPerRow)*(LI(rows) * (16384 + LI(dx)) / 32768));
WHILE (y>0) AND (LI(b)>LI(planes[0])) DO
DEC(b,bytesPerRow);
CopyBytes((bytesPerRow-4)/4,a,b);
INC(p,16384);
WHILE (p>dx) AND (y>0) DO
DEC(p,dx); DEC(y,1); INC(a,bytesPerRow);
END;
END;
IF NOT(lmb IN Ciapra) THEN EXIT END;
LoadView(ADR(view));
END;
FOR i:=0 TO 63 BY 2 DO
a := planes[0]; b := vBitMap.planes[0];
dx:= Sinus^[64-i]; p := 0; y := rows;
INC(b,LI(bytesPerRow)*(LI(rows) * (16384 + LI(dx)) / 32768));
WHILE (y>0) AND (LI(b)>LI(planes[0])) DO
DEC(b,bytesPerRow);
CopyBytes((bytesPerRow-4)/4,a,b);
INC(p,16384);
WHILE (p>dx) AND (y>0) DO
DEC(p,dx); DEC(y,1); INC(a,bytesPerRow);
END;
END;
IF NOT(lmb IN Ciapra) THEN EXIT END;
LoadView(ADR(view));
END;
FOR i:=0 TO 63 BY 2 DO
a := planes[0]; b := vBitMap.planes[0];
dx:= Sinus^[i]; p := 0; y := rows;
INC(b,LI(bytesPerRow)*(LI(rows) * (16384 - LI(dx)) / 32768));
WHILE (y>0) AND (LI(b)<MaxAdr) DO
CopyBytes((bytesPerRow-4)/4,a,b);
INC(b,bytesPerRow); INC(p,16384);
WHILE (p>dx) AND (y>0) DO
DEC(p,dx); DEC(y,1); INC(a,bytesPerRow);
END;
END;
IF NOT(lmb IN Ciapra) THEN EXIT END;
LoadView(ADR(view));
END;
END;
END;
EnableIntuition;
END Rotate.